create_psrc_map <- function(lyr,
lyr_data_field,
legend_title,
legend_subtitle,
psrc_col_pal,
map_lat = 47.615,
map_lon = -122.257,
map_zoom = 8.5,
wgs84 = 4326) {
# psrc colors need more contrast to work
pal <-
leaflet::colorNumeric(palette = psrc_col_pal, domain = lyr_data_field)
css_fix <-
"div.info.legend.leaflet-control br {clear: both;} html * {font-family: Poppins !important;}" # CSS to correct spacing and font family
html_fix <-
htmltools::tags$style(type = "text/css", css_fix) # Convert CSS to HTML
labels <-
paste0('Estimate: ', prettyNum(round(lyr_data_field,-1), big.mark = ",")) %>%
lapply(htmltools::HTML)
m <- leaflet::leaflet() %>%
leaflet::addMapPane(name = "polygons", zIndex = 410) %>%
leaflet::addMapPane(name = "maplabels", zIndex = 500) %>% # higher zIndex rendered on top
leaflet::addProviderTiles("CartoDB.VoyagerNoLabels") %>%
leaflet::addProviderTiles(
"CartoDB.VoyagerOnlyLabels",
options = leaflet::leafletOptions(pane = "maplabels"),
group = "Labels"
) %>%
leaflet::addEasyButton(leaflet::easyButton(
icon = htmltools::span(class = "globe", htmltools::HTML("🌎")), #🌐 (another emoji option) #"fa-globe", (font awesome icon no longer works because of the conversion to Poppins font below)
title ="Region",
onClick=JS("function(btn, map){map.setView([47.615,-122.257],8.5); }")))%>%
leaflet::addPolygons(
data = lyr,
fillOpacity = 0.7,
fillColor = pal(lyr_data_field),
weight = 0.7,
color = "#BCBEC0",
group = "estimate",
opacity = 0,
stroke = FALSE,
options = leaflet::leafletOptions(pane = "polygons"),
dashArray = "",
highlight = leaflet::highlightOptions(
weight = 5,
color = "76787A",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE
),
label = labels,
labelOptions = leaflet::labelOptions(
style = list(
"font-weight" = "normal",
padding = "3px 8px",
"font-family" = "Poppins"
)
)
) %>%
leaflet::addLegend(
pal = pal,
values = lyr_data_field,
position = "bottomright",
title = paste(legend_title, '<br>', legend_subtitle)
) %>%
leaflet::addLayersControl(baseGroups = "CartoDB.VoyagerNoLabels",
overlayGroups = c("Labels", "estimate")) %>%
leaflet::setView(lng = map_lon, lat = map_lat, zoom = map_zoom) %>%
htmlwidgets::prependContent(html_fix) # Insert into leaflet HTML code
return(m)
}
big_tbl<-read.csv('tract_accessibility_2018.csv')
tbl <- big_tbl %>% mutate(geoid10=as.character(tract_geoid10))
tract_layer_name <- "TRACT2010_NOWATER"
lyr <- st_read_elmergeo(tract_layer_name)
lyr_data<- dplyr::left_join(lyr,tbl, by="geoid10")
# this is the field to map
lyr_data_field<-lyr_data$access
big_tbl <-psrccensus::get_acs_recs(geography='tract',table.names='B03001',year=2019, acs.type='acs5')
hisp_tbl <- big_tbl %>%filter(label=='Estimate!!Total:!!Hispanic or Latino:')%>%
dplyr::select(GEOID,estimate) %>%
dplyr::mutate(dplyr::across(c('GEOID'), as.character))%>%
dplyr::group_by(GEOID) %>%
dplyr::summarise(Total=sum(estimate))
lyr_data_2<- dplyr::left_join(lyr_data,hisp_tbl, by = c("geoid10"='GEOID'))
# this is the field to map
lyr_data_field_2<-lyr_data_2$Total
Nationally, Hispanic populations report relatively high use of public transit compared with whites. But in the central Puget Sound region, Census data shows that Hispanics tend to commute by car more often than other groups.
Additionally, Hispanic transit commute rates tend to be roughly on par with whites and substantially below the rates for Black and Asian groups.
This led us to wonder what are the factors that inform these choices, and what are some of the pressures that lead the area’s Hispanics to favor cars over transit at higher rates than other populations.
First, we looked at the places that the Hispanic populace lives. Using Census data from the American Community Survey, we looked at the Hispanic population counts by tract. As shown in the map below, the roughly 441,000 Hispanic people in the region tend to live in either South King County – notably Burien, Des Moines, Federal Way and Auburn – and Southern Snohomish County along the SR 99 Corridor.
To see how well commuters in these heavily Hispanic areas are served by transit, we calculated the number of jobs accessible by transit within 45 minutes for each Census tract. This map, below, shows that the areas with best transit access to jobs are concentrated in central Seattle and Bellevue. Residents in these areas can reach a large pool of jobs by a 45-minute transit ride – nearly 800,000 for some tracts. By contrast, people living in the most heavily Hispanic areas can reach a much smaller pool by equivalent means: many can reach only between 30 and 60 thousand within the same 45-minute window. Residents of the tract with the single highest Hispanic population, in Auburn, have only 20,000 jobs accessible within this window And the fewer the jobs accessible by transit, the higher the likelihood that a given worker will need to drive to get to his or her place of work.